home *** CD-ROM | disk | FTP | other *** search
/ MacFormat España 4 / MacFormat n. 4 (Spain) / MacFormat 4.bin / La ciudad del ShareWare / Desarrollo / ICAppSourceKit1.0 / ICFontWhats.p < prev    next >
Encoding:
Text File  |  1994-11-06  |  5.6 KB  |  187 lines
  1. unit ICFontWhats;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ICWindowGlobals;
  7.  
  8.     function WhatOpenFont (wt: WindowType; item: integer): OSErr;
  9.     function WhatFlushFont (wt: WindowType; item: integer): OSErr;
  10.     function WhatClickFont (wt: WindowType; item: integer; er: eventRecord): OSErr;
  11.     function WhatClickFontSize (wt: WindowType; item: integer; er: eventRecord): OSErr;
  12.  
  13. implementation
  14.  
  15.     uses
  16.         Script, 
  17.  
  18.         ICStrH, 
  19.  
  20.         ICKeys, ICAPI, ICDialogs, ICMiscSubs, ICSubs, ICDocUtils;
  21.  
  22.     procedure SetSizeOutlines (sizemenu: MenuHandle; font_num: integer);
  23.         var
  24.             tmpstr: Str255;
  25.             i: integer;
  26.             the_size: longint;
  27.     begin
  28.         for i := 1 to CountMItems(sizemenu) do begin
  29.             GetItem(sizemenu, i, tmpstr);
  30.             StringToNum(tmpstr, the_size);
  31.             if RealFont(font_num, the_size) then begin
  32.                 SetItemStyle(sizemenu, i, [outline]);
  33.             end
  34.             else begin
  35.                 SetItemStyle(sizemenu, i, []);
  36.             end; (* if *)
  37.         end; (* for *)
  38.     end; (* SetSizeOutlines *)
  39.  
  40.     procedure GetCurrentSetting (dlg: DialogPtr; item: integer; var font_setting: ICFontRecord; var font_num: integer);
  41.         var
  42.             fontmenu, sizemenu: MenuHandle;
  43.             tmpstr: Str255;
  44.             tmpint: longint;
  45.     begin
  46.         fontmenu := GetPopupMHandle(dlg, item);
  47.         sizemenu := GetPopupMHandle(dlg, item + 1);
  48.         (* collect current values *)
  49.         font_setting.face := [];
  50.         GetItem(fontmenu, GetDCtlValue(dlg, item), font_setting.font);
  51.         GetItem(sizemenu, GetDCtlValue(dlg, item + 1), tmpstr);
  52.         StringToNum(tmpstr, tmpint);
  53.         if (tmpint > 0) and (tmpint < 32767) then begin
  54.             font_setting.size := tmpint;
  55.         end
  56.         else begin
  57.             font_setting.size := GetDefFontSize;
  58.         end; (* if *)
  59.         GetFNum(font_setting.font, font_num);
  60.     end;
  61.  
  62.     procedure DisplayFontProc (dlg: DialogPtr; item: integer);
  63.         var
  64.             font_setting: ICFontRecord;
  65.             saved: SavedWindowInfo;
  66.             font: integer;
  67.             r: rect;
  68.             s: str255;
  69.             name: Str255;
  70.     begin
  71.         SetPort(dlg);
  72.         GetCurrentSetting(dlg, item - 2, font_setting, font);
  73.         EnterWindow(dlg, font, font_setting.size, [], saved);
  74.         GetDItemRect(dlg, item, r);
  75.         PenPat(gray);
  76.         FrameRect(r);
  77.         PenPat(black);
  78.         GetFontName(font, name);
  79.         if (name = 'Chicago') & (((item = 3) & (font_setting.size <> 12)) | (item = 6)) then begin
  80.             s := GetIndStr(128, 16);
  81.         end
  82.         else begin
  83.             s := GetIndStr(128, 14);
  84.         end; (* if *)
  85.         InsetRect(r, 3, 3);
  86.         TextBox(@s[1], length(s), r, teJustLeft);
  87.         ExitWindow(saved);
  88.     end;
  89.  
  90.     function WhatOpenFont (wt: WindowType; item: integer): OSErr;
  91.         var
  92.             dlg: WindowPtr;
  93.             fontmenu: MenuHandle;
  94.             sizemenu: MenuHandle;
  95.             font_setting: ICFontRecord;
  96.             attr: longint;
  97.             i: integer;
  98.             tmpstr: Str255;
  99.             test_name: Str255;
  100.             count: longint;
  101.             font_num: integer;
  102.     begin
  103.         dlg := windowinfo[wt].window;
  104.         count := sizeof(font_setting);
  105.         if (ICMapErr(ICGetPref(GetInstance, windowinfo[wt].items[item]^.key, attr, @font_setting, count)) <> noErr) | (count <> sizeof(font_setting)) then begin
  106.             GetFontName(GetAppFont, font_setting.font);
  107.             font_setting.face := [];
  108.             font_setting.size := GetDefFontSize;
  109.         end; (* if *)
  110.         ProcessAttributes(wt, item, attr);
  111.         GetFNum(font_setting.font, font_num);
  112.         if font_num = 0 then begin
  113.             GetFontName(GetAppFont, font_setting.font);
  114.             GetFNum(font_setting.font, font_num);
  115.         end; (* if *)
  116.         fontmenu := GetPopupMHandle(dlg, item);
  117.         for i := 1 to CountMItems(fontmenu) do begin
  118.             GetItem(fontmenu, i, test_name);
  119.             if IUEqualString(test_name, font_setting.font) = 0 then begin
  120.                 SetDCtlValue(dlg, item, i);
  121.             end; (* if *)
  122.         end; (* for *)
  123.         NumToString(font_setting.size, tmpstr);
  124.         sizemenu := GetPopupMHandle(dlg, item + 1);
  125.         for i := 1 to CountMItems(sizemenu) do begin
  126.             GetItem(sizemenu, i, test_name);
  127.             if IUEqualString(test_name, tmpstr) = 0 then begin
  128.                 SetDCtlValue(dlg, item + 1, i);
  129.             end; (* if *)
  130.         end; (* for *)
  131.         SetSizeOutlines(sizemenu, font_num);
  132.         SetDCtlEnable(dlg, item, not IsLocked(wt, item));
  133.         SetDCtlEnable(dlg, item + 1, not IsLocked(wt, item));
  134.         SetDItemHandle(dlg, item + 2, handle(@DisplayFontProc));
  135.         WhatOpenFont := noErr;
  136.     end; (* WhatOpenFont *)
  137.  
  138.     function WhatClickFont (wt: WindowType; item: integer; er: eventRecord): OSErr;
  139.         var
  140.             dlg: DialogPtr;
  141.             font_setting: ICFontRecord;
  142.             font_num: integer;
  143.     begin
  144.         dlg := windowinfo[wt].window;
  145.         GetCurrentSetting(dlg, item, font_setting, font_num);
  146.         SetSizeOutlines(GetPopupMHandle(dlg, item + 1), font_num);
  147.         DisplayFontProc(dlg, item + 2);
  148.         WhatClickFont := noErr;
  149.     end;  (* WhatClickFont *)
  150.  
  151.     function WhatClickFontSize (wt: WindowType; item: integer; er: eventRecord): OSErr;
  152.     begin
  153.         DisplayFontProc(windowinfo[wt].window, item + 1);
  154.         WhatClickFontSize := noErr;
  155.     end;
  156.  
  157.     function WhatFlushFont (wt: WindowType; item: integer): OSErr;
  158.         var
  159.             dlg: DialogPtr;
  160.             err: OSErr;
  161.             font_setting: ICFontRecord;
  162.             old_font_setting: ICFontRecord;
  163.             attr: longint;
  164.             count: longint;
  165.             font: integer;
  166.     begin
  167.         dlg := windowinfo[wt].window;
  168.         GetCurrentSetting(dlg, item, font_setting, font);
  169.         (* get old values *)
  170.         count := sizeof(old_font_setting);
  171.         if (ICMapErr(ICGetPref(GetInstance, windowinfo[wt].items[item]^.key, attr, @old_font_setting, count)) <> noErr) | (count <> sizeof(old_font_setting)) then begin
  172.             old_font_setting.font := '';
  173.         end; (* if *)
  174.         (* write it back if changed *)
  175.         err := noErr;
  176.         if (old_font_setting.size <> font_setting.size) or (old_font_setting.face <> font_setting.face) or (IUEqualString(old_font_setting.font, font_setting.font) <> 0) then begin
  177.             if not IsLocked(wt, item) then begin
  178.                 err := ICMapErr(ICSetPref(GetInstance, windowinfo[wt].items[item]^.key, ICattr_no_change, @font_setting, sizeof(font_setting)));
  179.                 if err = noErr then begin
  180.                     DirtyDocument;
  181.                 end; (* if *)
  182.             end; (* if *)
  183.         end; (* if *)
  184.         WhatFlushFont := err;
  185.     end; (* WhatFlushFont *)
  186.  
  187. end. (* ICFontWhats *)